home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
BPL70N16
/
ARISOURC.ZIP
/
FPFML.ASM
< prev
next >
Wrap
Assembly Source File
|
1993-03-07
|
7KB
|
159 lines
; *******************************************************
; * *
; * Turbo Pascal Runtime Library Version 7.0 *
; * Real Fast Multiplication *
; * *
; * Copyright (C) 1992,1993 Norbert Juffa *
; * *
; *******************************************************
TITLE FPFML
CODE SEGMENT BYTE PUBLIC 'CODE'
ASSUME CS: CODE
PUBLIC RealMulF, RealMulFNoChk, RealMulFNChk2, ShortMul, ShortMulRev
; DI:..:CL
; DX:BX:AX
ShortMulRev PROC NEAR
XCHG AX, CX
MOV BX, SI
XCHG DX, DI
ShortMulRev ENDP
ShortMul PROC NEAR
PUSH BP ; save TURBO-framepointer
XCHG BX, DI ; BX = b1, DI = a2
MOV BP, DX ; get sign of multiplicant
XOR BP, BX ; compute sign of result
AND BP, 8000h ; mask out sign bit
XCHG AL, CH ; save b3
ADD CL, CH ; sum of biased exponents
SBB CH, CH ; clear msb
NEG CH ; and put possible overflow in CH
OR CX, BP ; zap in sign bit
PUSH CX ; save new exponent and sign bit
XOR CX, CX ; clear lo-bytes of a3 and b3
OR DH, 80h ; set implicit bit of multipicand
OR BH, 80h ; set implicit bit of multiplicator
MOV SI, DX ; save a1
MUL BX ; b1 * a3
MOV BP, AX ; generate sticky byte = 0
XCHG AX, DX ; AX = msw of product
XCHG AX, DI ; save msw of product, get a2
MUL BX ; b1 * a2
XCHG AX, BX ; save lsw of product, get b1
XCHG DX, SI ; save msw of product, get a1
ADD BX, DI ; add product
ADC SI, CX ; to FPA
MUL DX ; b1 * a1
ADD AX, SI ; add product
ADC DX, CX ; result in DX:AX:BX
JMP $end_mantiss ; handle exponent
$zero_res: JMP $zero_prod2 ; result is 0
ShortMul ENDP
ALIGN 4
RealMulF PROC NEAR
OR CL, CL ; multiplicator = 0 ?
JZ $zero_res ; result will be 0
RealMulFNoChk PROC NEAR
OR AL, AL ; multiplicand = 0 ?
JZ $zero_res ; result is zero
RealMulFNChk2 PROC NEAR
PUSH BP ; save TURBO-framepointer
XCHG BX, DI ; BX = b1, DI = a2
MOV BP, DX ; get sign of multiplicant
XOR BP, BX ; compute sign of result
AND BP, 8000h ; mask out sign bit
XCHG AL, CH ; save b3
ADD CL, CH ; sum of biased exponents
SBB CH, CH ; clear msb
NEG CH ; and put possible overflow in CH
OR CX, BP ; zap in sign bit
PUSH CX ; save new exponent and sign bit
XOR CX, CX ; clear lo-bytes of a3 and b3
OR DH, 80h ; set implicit bit of multipicand
OR BH, 80h ; set implicit bit of multiplicator
$full_mult: XCHG AL, CH ; CH = b3, AL = 0
PUSH BX ; save b1
PUSH DX ; save a1
MOV BP, DX ; save a1
MUL BX ; b1 * a3
XOR BX, BX ; clear FPA
XCHG AX, CX ; get b3, save LSW (b1*a3)
XCHG DX, BP ; get a1, save MSW (b1*a3)
MUL DX ; a1 * b3
ADD CX, AX ; add
ADC BP, DX ; result
ADC BX, BX ; to FPA
MOV AX, SI ; b2
MUL DI ; a2 * b2
ADC CX, AX
ADC BP, DX
ADC BX, 0
XOR CX, CX ; FPA = CX:BX:BP
XCHG AX, SI ; get b2
POP SI ; get a1
MUL SI ; a1 * b2
ADD BP, AX ; add
ADC BX, DX ; result
ADC CX, CX ; to FPA
XCHG AX, DI ; get a2
POP DI ; get b1
MUL DI ; a2 * b1
ADD BP, AX ; add result
XCHG AX, DI ; get a1
XCHG CX, SI ; CX = b1
MOV DI, BX ; FPA = SI:DI:BX
MOV BX, BP ;
$sqr_end: ADC DI, DX ; to SI:DI:BX
ADC SI, 0 ; FPA
MUL CX ; a1 * b1
ADD AX, DI
ADC DX, SI ; result in DX:AX:BX
$end_mantiss:POP CX ; CH = exponent CL = sign
XCHG AX, BX ; DX:BX:AX = result
SUB CX, 81h ; compute new exponent-1
$div_end: OR DX, DX ; is mantissa normalized ?
JS $add_sub_end ; yes
ADD AX, AX ; no, shift
ADC BX, BX ; FPA 1 bit
ADC DX, DX ; to the left
DEC CX ; adjust exponent
$add_sub_end:XOR SI, SI ; load zero
ADC AX, 80h ; round
ADC BX, SI ; up
ADC DX, SI ; mantissa
ADC CX, SI ; increment exponent if mantissa overfl.
$round_done: POP BP ; restore caller's frame pointer
TEST CH, 40H ; test if (exponent-1) negative
JNZ $zero_prod2 ; yes, underflow, return zero
AND DH, 7Fh ; force MSB of mantissa to 0
INC CX ; new exponent
MOV AL, CL ; store exponent
OR DH, CH ; fill in sign bit
SHR CH, 1 ; test if exponent overflow (> FFh)
RET ; done
$zero_prod2: XOR AX, AX ; load
MOV BX, AX ; a
CWD ; zero
RET ; done
RealMulFNChk2 ENDP
RealMulFNoChk ENDP
RealMulF ENDP
ALIGN 4
ENDS
END